home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kolekce / d3456 / GmPrintSuite_2_61_Lite.exe / {app} / GmRtfFuncs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  10.0 KB  |  324 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                          GmRtfFuncs.pas v2.61 Pro                            }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.co.uk               }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.co.uk                              }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmRtfFuncs;
  14.  
  15. interface
  16.  
  17. uses Windows, Classes, stdctrls, Graphics, RichEdit, GmTypes, comctrls, Forms, Dialogs;
  18.  
  19. type
  20.   TGmRtfInformation = class;
  21.  
  22.   TGmRtfOffset = class
  23.   private
  24.     FRtfInfo: TGmRtfInformation;
  25.     FPage: integer;
  26.     FStartChar: integer;
  27.     FEndChar: integer;
  28.     FRtfRect: TRect;
  29.     FTopMargin: Extended;
  30.     FBottomMargin: Extended;
  31.   public
  32.     constructor Create(RtfInfo: TGmRtfInformation);
  33.     constructor CreateRect(RtfInfo: TGmRtfInformation; ARect: TRect; SC, EC, Page: integer;
  34.       MT, MB: Extended);
  35.     property StartChar: integer read FStartChar write FStartChar;
  36.     property EndChar: integer read FEndChar write FEndChar;
  37.     property Page: integer read FPage write FPage;
  38.     property RtfRect: TRect read FRtfRect write FRtfRect;
  39.     property MarginTop: Extended read FTopMargin;
  40.     property MarginBottom: Extended read FBottomMargin;
  41.   end;
  42.  
  43.   TGmRtfInformation = class(TCustomRtfInformation)
  44.   private
  45.     FRichEdit: TCustomMemo;
  46.     FClassName: string;
  47.     FTempForm: TForm;
  48.     FOnChange: TNotifyEvent;
  49.     function GetOffset(index: integer): TGmRtfOffset;
  50.     function GetOffsetForPage(index: integer): TGmRtfOffset;
  51.     procedure SetOfffset(index: integer; const Value: TGmRtfOffset);
  52.     procedure SetRichEdit(ARichEdit: TCustomMemo);
  53.   public
  54.     constructor Create;
  55.     destructor Destroy; override;
  56.     procedure AddOffset(ARect: TRect; Page, StartChar, EndChar: integer; MT, MB: Extended);
  57.     procedure Clear; {$IFNDEF VER100} {$IFNDEF VER110} override; {$ENDIF}{$ENDIF}
  58.     property RichEdit: TCustomMemo read FRichEdit write SetRichEdit;
  59.     property Form: TForm read FTempForm;
  60.     property Offset[index: integer]: TGmRtfOffset read GetOffset write SetOfffset;
  61.     property OffsetForPage[index: integer]: TGmRtfOffset read GetOffsetForPage;
  62.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  63.   end;
  64.  
  65.   procedure DrawRichText(ACanvas: TCanvas; ARichText: TCustomMemo; Sc, Ec: integer;
  66.     AMargins: TGmRect; PageSize: TGmSize);
  67.   procedure GetRtfText( ARichEdit: TCustomMemo; intoStream: TStream );
  68.   procedure InsertRTF(aRichEdit: TCustomMemo; s: String);
  69.   procedure PutRTFSelection( aRichEdit: TCustomMemo; sourceStream: TStream);
  70.  
  71. implementation
  72.  
  73. uses GmPreview, Controls, Messages, Printers;
  74.  
  75. //------------------------------------------------------------------------------
  76.  
  77. type TEditStreamCallBack = function (dwCookie: Longint; pbBuff: PByte;
  78. cb: Longint; var pcb: Longint): {$IFDEF VER100} DWORD; stdcall; {$ELSE}
  79.                                 {$IFDEF VER120} DWORD; stdcall; {$ELSE}
  80.                                                 Integer; stdcall;
  81.                                 {$ENDIF} {$ENDIF}
  82.  
  83. TEditStream = record
  84.   dwCookie: Longint;
  85.   dwError: Longint;
  86.   pfnCallback: TEditStreamCallBack;
  87. end;
  88.  
  89. function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
  90. cb: Longint; var pcb: Longint): {$IFDEF VER110} DWORD; stdcall; {$ELSE}
  91.                                 {$IFDEF VER120} DWORD; stdcall; {$ELSE}
  92.                                                 Integer; stdcall;
  93.                                 {$ENDIF} {$ENDIF}
  94. var
  95.   theStream: TStream;
  96.   dataAvail: LongInt;
  97. begin
  98.   theStream := TStream(dwCookie);
  99.   with theStream do
  100.     begin
  101.       dataAvail := Size - Position;
  102.       Result := 0;  {assume everything is ok}
  103.       if dataAvail <= cb then
  104.       begin
  105.         pcb := Read(pbBuff^, dataAvail);
  106.         if pcb <> dataAvail then  {couldn't read req. amount of bytes}
  107.           result := E_FAIL;
  108.       end
  109.       else
  110.       begin
  111.         pcb := Read(pbBuff^, cb);
  112.         if pcb <> cb then
  113.           result := E_FAIL;
  114.       end;
  115.     end;
  116. end;
  117.  
  118. procedure PutRTFSelection( aRichEdit: TCustomMemo; sourceStream: TStream);
  119. var
  120.   editstream: TEditStream;
  121. begin
  122.   with editstream do
  123.   begin
  124.     dwCookie := Longint(sourceStream);
  125.     dwError := 0;
  126.     pfnCallback := EditStreamInCallBack;
  127.   end;
  128.   aRichedit.Perform( EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));
  129. end;
  130.  
  131.  
  132. procedure InsertRTF(aRichEdit: TCustomMemo; s: String);
  133. var
  134.   aMemStream: TMemoryStream;
  135. begin
  136.   if Length(s) > 0 then
  137.   begin
  138.     aMemStream := TMemoryStream.Create;
  139.     try
  140.       aMemStream.Write(s[1], length(s));
  141.       aMemStream.Position := 0;
  142.       //aRichEdit.SetSelTextBuf(PChar(s));
  143.       PutRTFSelection( aRichEdit, aMemStream );
  144.     finally
  145.       aMemStream.Free;
  146.     end;
  147.   end;
  148. end;
  149.  
  150. function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb:
  151. Longint; var pcb: Longint): {$IFDEF VER100} DWORD; stdcall; {$ELSE}
  152.                             {$IFDEF VER120} DWORD; stdcall; {$ELSE}
  153.                                             Integer; stdcall;
  154.                             {$ENDIF} {$ENDIF}
  155. var 
  156.   theStream: TStream;
  157. begin
  158.   theStream := TStream(dwCookie);
  159.   with theStream do
  160.   begin
  161.     if cb > 0 then
  162.       pcb := Write(pbBuff^, cb);
  163.     Result := 0;
  164.   end;
  165. end;
  166.  
  167. procedure GetRtfText( ARichEdit: TCustomMemo; intoStream: TStream );
  168. var
  169.   editstream: TEditStream;
  170. begin
  171.   with editstream do
  172.   begin
  173.     dwCookie := Longint(intoStream);
  174.     dwError := 0;
  175.     pfnCallback := EditStreamOutCallBack;
  176.   end;
  177.   ARichEdit.Perform( EM_STREAMOUT, SF_RTF, longint(@editstream));
  178. end;
  179.  
  180. //------------------------------------------------------------------------------
  181.  
  182. // *** TGmRtfOffset ***
  183.  
  184. constructor TGmRtfOffset.Create(RtfInfo: TGmRtfInformation);
  185. begin
  186.   inherited Create;
  187.   FRtfInfo := RtfInfo;
  188. end;
  189.  
  190. constructor TGmRtfOffset.CreateRect(RtfInfo: TGmRtfInformation; ARect: TRect; SC, EC, Page: integer;
  191.   MT, MB: Extended);
  192. begin
  193.   Create(RtfInfo);
  194.   FStartChar := SC;
  195.   FEndChar := EC;
  196.   FRtfRect := ARect;
  197.   FTopMargin := MT;
  198.   FBottomMargin := MB;
  199.   FPage := Page;
  200. end;
  201.  
  202. //------------------------------------------------------------------------------
  203.  
  204. // *** TGmRtfInfotmation ***
  205.  
  206. constructor TGmRtfInformation.Create;
  207. begin
  208.   inherited Create;
  209.   FTempForm := TForm.Create(nil);
  210. end;
  211.  
  212. destructor TGmRtfInformation.Destroy;
  213. begin
  214.   if FClassName <> 'TRichEdit98' then FRichEdit.Free;
  215.   FTempForm.Free;
  216.   Clear;
  217.   inherited Destroy;
  218. end;
  219.  
  220. function TGmRtfInformation.GetOffset(index: integer): TGmRtfOffset;
  221. begin
  222.   Result := TGmRtfOffset(Self[index]);
  223. end;
  224.  
  225. function TGmRtfInformation.GetOffsetForPage(index: integer): TGmRtfOffset;
  226. var
  227.   ICount: integer;
  228. begin
  229.   Result := nil;
  230.   for ICount := 0 to Count-1 do
  231.     if Offset[ICount].Page = index then Result := Offset[ICount];
  232. end;
  233.  
  234. procedure TGmRtfInformation.SetOfffset(index: integer;
  235.   const Value: TGmRtfOffset);
  236. begin
  237.   Self[index] := Value;
  238. end;
  239.  
  240. procedure TGmRtfInformation.SetRichEdit(ARichEdit: TCustomMemo);
  241. begin
  242.     FRichEdit := ARichEdit;
  243.   if Assigned(FRichEdit) then FClassName := FRichEdit.ClassName;
  244. end;
  245.  
  246. procedure TGmRtfInformation.AddOffset(ARect: TRect; Page, StartChar, EndChar: integer; MT, MB: Extended);
  247. begin
  248.   Add(TGmRtfOffset.CreateRect(Self, ARect, StartChar, EndChar, Page, MT, MB));
  249.   if Assigned(FOnChange) then FOnChange(Self);
  250. end;
  251.  
  252. procedure TGmRtfInformation.Clear;
  253. var
  254.   ICount: integer;
  255. begin
  256.   // clear the page...
  257.   for ICount := Count-1 downto 0 do
  258.   begin
  259.     TGmRtfOffset(Self[ICount]).Free;
  260.     Self.Delete(ICount);
  261.   end;
  262.   inherited Clear;
  263.   if Assigned(FOnChange) then FOnChange(Self);
  264. end;
  265.  
  266. //------------------------------------------------------------------------------
  267.  
  268. procedure DrawRichText(ACanvas: TCanvas; ARichText: TCustomMemo; Sc, Ec: integer;
  269.     AMargins: TGmRect; PageSize: TGmSize);
  270. var
  271.   Ppi,
  272.   pw,
  273.   ph : integer;
  274.   Margins: TRect;
  275.   richedit_outputarea,
  276.   SaveRect,
  277.   printArea: TRect;
  278.   ATwip: Extended;
  279.   Range: TFormatRange;
  280. begin
  281.   Ppi := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  282.   Pw := Round(PageSize.Width * Ppi);
  283.   Ph := Round(PageSize.Height * Ppi);
  284.  
  285.   Margins := Rect(Round(AMargins.Left * Ppi),
  286.                   Round(AMargins.Top * Ppi),
  287.                   Round(AMargins.Right * Ppi),
  288.                   Round(AMargins.Bottom * Ppi));
  289.   printarea := Rect(0 + Margins.Left,
  290.                     0 + Margins.Top,
  291.                     pw - Margins.Right,
  292.                     ph - Margins.Bottom);
  293.  
  294.   {Define a rectangle for the rich edit text. The height is set to the maximum. But
  295.   we need to convert from device units to twips, 1 twip = 1/1440 inch or 1/20 point.}
  296.  
  297.   ATwip := 1440 / Ppi;
  298.   richedit_outputarea := Rect(Round(printarea.left * ATwip),
  299.                               Round(printarea.top * ATwip) ,
  300.                               Round(printarea.right * ATwip) ,
  301.                               Round(printarea.bottom * ATwip));
  302.   SaveRect := richedit_outputarea;
  303.  
  304.   {Tell rich edit to format its text to the printer. First set up data record for message:}
  305.   Range.hDC := ACanvas.Handle;  {printer handle}
  306.   Range.hdcTarget := Printer.Handle;  {ditto}
  307.   Range.rc := richedit_outputarea;
  308.   Range.rcPage := richedit_outputarea;
  309.   Range.chrg.cpMin := Sc;
  310.   Range.chrg.cpMax := Ec;
  311.  
  312.   ARichText.Perform( EM_FORMATRANGE, 0, Longint(@Range));
  313.   try
  314.     ARichText.Perform( EM_FORMATRANGE, 1, Longint(@Range));
  315.   finally
  316.     {Free cached information}
  317.     ARichText.Perform( EM_FORMATRANGE, 0, Longint(@Range));
  318.   end;
  319. end;
  320.  
  321. end.
  322.  
  323.  
  324.